/*
 * TOOLS.C   	                    Copyright (c) 2002-08, Asko Kauppi
 *
 * Lua tools, from GluaX code base.
*/

/*
===============================================================================

Copyright (C) 2002-08 Asko Kauppi <akauppi@gmail.com>

Permission is hereby granted, free of charge, to any person obtaining a copy
of this software and associated documentation files (the "Software"), to deal
in the Software without restriction, including without limitation the rights
to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
copies of the Software, and to permit persons to whom the Software is
furnished to do so, subject to the following conditions:

The above copyright notice and this permission notice shall be included in
all copies or substantial portions of the Software.

THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.  IN NO EVENT SHALL THE
AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN
THE SOFTWARE.

===============================================================================
*/

#include "tools.h"
#include "threading.h"
    // LOCK_T

#include "lualib.h"
#include "lauxlib.h"

#include <stdio.h>
#include <string.h>
#include <ctype.h>
#include <stdlib.h>


/*---=== luaG_openlibs ===---*/

static const luaL_Reg libs[] = {
  { LUA_LOADLIBNAME, luaopen_package },
  { LUA_TABLIBNAME, luaopen_table },
  { LUA_IOLIBNAME, luaopen_io },
  { LUA_OSLIBNAME, luaopen_os },
  { LUA_STRLIBNAME, luaopen_string },
  { LUA_MATHLIBNAME, luaopen_math },
  { LUA_DBLIBNAME, luaopen_debug },
  //
  { "base", NULL },         // ignore "base" (already acquired it)
  { "coroutine", NULL },    // part of Lua 5.1 base package
  { NULL, NULL }
};

static bool_t openlib( lua_State *L, const char *name, size_t len ) {

    unsigned i;
    bool_t all= strncmp( name, "*", len ) == 0;

    for( i=0; libs[i].name; i++ ) {
        if (all || (strncmp(name, libs[i].name, len) ==0)) {
            if (libs[i].func) {
                STACK_GROW(L,2);
                lua_pushcfunction( L, libs[i].func );
                lua_pushstring( L, libs[i].name );
                lua_call( L, 1, 0 );
            }
            if (!all) return TRUE;
        }
    }
    return all;
}

/* 
* Like 'luaL_openlibs()' but allows the set of libraries be selected
*
*   NULL    no libraries, not even base
*   ""      base library only
*   "io,string"     named libraries
*   "*"     all libraries
*
* Base ("unpack", "print" etc.) is always added, unless 'libs' is NULL.
*/
#define is_name_char(c) (isalpha(c) || (c)=='*')

const char *luaG_openlibs( lua_State *L, const char *libs ) {
    const char *p;
    unsigned len;

	if (!libs) return NULL;     // no libs, not even 'base'

    // 'lua.c' stops GC during initialization so perhaps its a good idea. :)
    //
    lua_gc(L, LUA_GCSTOP, 0);

    // Anything causes 'base' to be taken in
    //
    STACK_GROW(L,2);
    lua_pushcfunction( L, luaopen_base );
    lua_pushliteral( L, "" );
    lua_call( L, 1, 0 );

    for( p= libs; p && *p; p+=len ) {
        len=0;
        while (*p && !is_name_char(*p)) p++;    // bypass delimiters
        while (is_name_char(p[len])) len++;     // bypass name
        if (len && (!openlib( L, p, len ))) {
            lua_pushlstring( L, p, len );
            luaL_error( L, "Unknown library: '%s'", lua_tostring(L,-1) );
        }
    }
    lua_gc(L, LUA_GCRESTART, 0);

    return NULL;    // ok
}



/*---=== Shared userdata ===---*/

/* The shared portion must be allocated separately of any Lua state's; it's
* lifespan may be longer than that of the creating state.
*/
#define SHARED_MALLOC malloc
#define SHARED_FREE   free
typedef volatile int SHARED_PRELUDE;     // reference counter at start of shared data

/* 
* 'registry[REGKEY]' is a two-way lookup table for 'idfunc's and those type's
* metatables:
*
*   metatable   ->  idfunc
*   idfunc      ->  metatable
*/
#define SHARED_LOOKUP_KEY set_shared_lookup
    // any unique light userdata

/*
* Sets up [-1]<->[-2] two-way lookups, and ensures the lookup table exists.
* Pops the both values off the stack.
*/
void set_shared_lookup( lua_State *L ) {

    STACK_GROW(L,3);

  STACK_CHECK(L)
    lua_pushlightuserdata( L, SHARED_LOOKUP_KEY );
    lua_rawget( L, LUA_REGISTRYINDEX );

    if (lua_isnil(L,-1)) {
        // First time here; let's make the lookup
        //
        lua_pop(L,1);

        lua_newtable(L);
        lua_pushlightuserdata( L, SHARED_LOOKUP_KEY );
        lua_pushvalue(L,-2);
            //
            // [-3]: {} (2nd ref)
            // [-2]: SHARED_LOOKUP_KEY
            // [-1]: {}

        lua_rawset( L, LUA_REGISTRYINDEX );
            //
            // [-1]: lookup table (empty)
    }
  STACK_MID(1)

    lua_insert(L,-3);

    // [-3]: lookup table
    // [-2]: A
    // [-1]: B
    
    lua_pushvalue( L,-1 );  // B
    lua_pushvalue( L,-3 );  // A
    lua_rawset( L, -5 );    // B->A
    lua_rawset( L, -3 );    // A->B
    lua_pop( L,1 );

  STACK_END(-2)
}

/*
* Pops the key (metatable or idfunc) off the stack, and replaces with the
* shared lookup value (idfunc/metatable/nil).
*/
void get_shared_lookup( lua_State *L ) {
    
    STACK_GROW(L,1);

  STACK_CHECK(L)    
    lua_pushlightuserdata( L, SHARED_LOOKUP_KEY );
    lua_rawget( L, LUA_REGISTRYINDEX );
    
    if (!lua_isnil(L,-1)) {
        // [-2]: key (metatable or idfunc)
        // [-1]: lookup table
    
        lua_insert( L, -2 );
        lua_rawget( L, -2 );
    
        // [-2]: lookup table
        // [-1]: value (metatable / idfunc / nil)
    }    
    lua_remove(L,-2);
        // remove lookup, or unused key
  STACK_END(0)
}

/*
* Return the registered ID function for 'index' (shared userdata proxy),
* or NULL if 'index' is not a shared userdata proxy.
*/
static
lua_CFunction get_idfunc( lua_State *L, int index ) {
    lua_CFunction ret;

    index= STACK_ABS(L,index);

    STACK_GROW(L,1);

  STACK_CHECK(L)
    if (!lua_getmetatable( L, index ))
        return NULL;    // no metatable
    
    // [-1]: metatable of [index]

    get_shared_lookup(L);
        //    
        // [-1]: idfunc/nil

    ret= lua_tocfunction(L,-1);
    lua_pop(L,1);
  STACK_END(0)
    return ret;
}


/*
* void= mt.__gc( proxy_ud )
*
* End of life for a proxy object; reduce the shared refrence count and clean
* it up if reaches 0.
*/
static
int shared_userdata_gc( lua_State *L ) {
    SHARED_PRELUDE **proxy= (SHARED_PRELUDE**)lua_touserdata( L, 1 );
    SHARED_PRELUDE *p= *proxy;
    int v;

    *proxy= 0;  // make sure we don't use it any more

    LOCK_START( &shared_lock );
      v= --(*p);
    LOCK_END( &shared_lock );

    if (v==0) {
        STACK_GROW(L,1);

        // Call 'idfunc( shared_ptr )' to make deep cleanup
        //
        lua_getmetatable(L,1);
        get_shared_lookup(L);
            //
            // [-1]: 'idfunc' of this type
        
        ASSERT_L( lua_iscfunction(L,-1) );

        lua_pushlightuserdata( L, ((char*)p) + sizeof(SHARED_PRELUDE) );
        lua_call( L, 1 /*args*/, 0 /*results*/ );
        
        SHARED_FREE( (void*)p );
    }
    return 0;
}


/*
* Push a proxy userdata on the stack.
*
* Initializes necessary structures if it's the first time 'idfunc' is being
* used in this Lua state (metatable, registring it).
*/
static 
void push_proxy( lua_State *L, lua_CFunction idfunc, SHARED_PRELUDE *deep_data ) {
    SHARED_PRELUDE **proxy;

    STACK_GROW(L,4);

  STACK_CHECK(L)

    proxy= lua_newuserdata( L, sizeof( SHARED_PRELUDE* ) );
    ASSERT_L(proxy);
    *proxy= deep_data;

    // Get/create metatable for 'idfunc' (in this state)
    //
    lua_pushcfunction( L, idfunc );    // key
    get_shared_lookup(L);
        //
        // [-2]: proxy
        // [-1]: metatable / nil
    
    if (lua_isnil(L,-1)) {
        // No metatable yet; make one and register it
        //
        lua_pop(L,1);

        lua_pushcfunction( L, idfunc );
        lua_call( L, 0 /*args*/, 1 /*results*/ );
            //
            // [-2]: proxy
            // [-1]: metatable (returned by 'idfunc')

        // Add '__gc' method
        //
        lua_pushcfunction( L, shared_userdata_gc );
        lua_setfield( L, -2, "__gc" );

        // Memorize for later rounds
        //
        lua_pushvalue( L,-1 );
        lua_pushcfunction( L, idfunc );
            //
            // [-4]: proxy
            // [-3]: metatable (2nd ref)
            // [-2]: metatable
            // [-1]: idfunc

        set_shared_lookup(L);
    }
  STACK_MID(2)
    ASSERT_L( lua_isuserdata(L,-2) );
    ASSERT_L( lua_istable(L,-1) );

    // [-2]: proxy userdata
    // [-1]: metatable to use

    lua_setmetatable( L, -2 );
    
  STACK_END(1)
    // [-1]: proxy userdata
}


/*
* Create a shared userdata
*
* 'idfunc' is the identity function for the data type, used for getting a
* metatable for the type (no parameters) or cleaning up when final reference
* is gone (one userdata as the parameter).
*
* This function does:
*   - creates a separately allocated "shared userdata" of 'size' bytes.
*   - initiates a hidden reference count for that shared data
*   - pushes a 'proxy' userdata for accessing the shared data in this Lua state
*   - sets a metatable for the proxy userdata (by calling 'idfunc', unless
*     that has already been done in this state)
*   - registers the metatable so it will be re-used at later times
*   - sets '__gc' method to automatically reduce reference count when the proxy
*     is no longer used
*
* Types using "shared userdata" system can be passed between separate Lua
* states via 'luaG_inter_move()'.
*
* Returns:  pointer to the new, shared userdata (to be initialized by the caller)
*
* Pushes:   'proxy' userdata for accessing the shared data via 'luaG_toshared()'
*/
void *luaG_newshared( lua_State *L, lua_CFunction idfunc, size_t bytes ) {
    void *ret;
    SHARED_PRELUDE *tmp= SHARED_MALLOC( sizeof(SHARED_PRELUDE) + bytes );
    ASSERT_L(tmp);

    *tmp= 1;    // beginning reference count
    ret= ((char*)tmp) + sizeof(SHARED_PRELUDE);

    push_proxy( L, idfunc, tmp );
        //
        // [-1]: proxy userdata

    return ret;
}


/*
* Access shared userdata through a proxy.
*
* Reference count is not changed, and access to the shared userdata is not
* serialized. It is the module's responsibility to prevent conflicting usage.
*/
void *luaG_toshared( lua_State *L, lua_CFunction idfunc, int index ) {
    void *ret;
    SHARED_PRELUDE **proxy;

  STACK_CHECK(L)
    if (get_idfunc(L,index) != idfunc)
        return NULL;    // no metatable, or wrong kind

    proxy= (SHARED_PRELUDE**)lua_touserdata( L, index );
    ret= ((char*)*proxy) + sizeof(SHARED_PRELUDE);
  STACK_END(0)

    return ret;
}


/*
* Copy shared userdata between two separate Lua states.
*
* Returns:
*   the id function of the copied value, or NULL for non-shared userdata
*   (not copied)
*/
static
lua_CFunction luaG_copyshared( lua_State *L, lua_State *L2, int index ) {
    SHARED_PRELUDE **proxy;
    SHARED_PRELUDE *p;

    lua_CFunction idfunc;
    
    idfunc= get_idfunc( L, index );
    if (!idfunc) return NULL;   // not a shared userdata

    // Increment reference count
    //
    proxy= (SHARED_PRELUDE**)lua_touserdata( L, index );
    p= *proxy;

    LOCK_START( &shared_lock );
      ++(*p);
    LOCK_END( &shared_lock );

    push_proxy( L2, idfunc, p );
        //
        // L2 [-1]: proxy userdata

    return idfunc;
}



/*---=== Inter-state copying ===---*/

static int buf_writer( lua_State *L, const void* b, size_t n, void* B ) {
  (void)L;
  luaL_addlstring((luaL_Buffer*) B, (const char *)b, n);
  return 0;
}


/*
* Copies a value from 'L' state (at index 'i') to 'L2' state. Does not remove
* the original value.
*
* NOTE: Both the states must be solely in the current OS thread's posession.
*
* 'i' is an absolute index (no -1, ...)
*
* Returns TRUE if value was pushed, FALSE if its type is non-supported.
*/
static bool_t inter_copy_one( lua_State *L, lua_State *L2, uint_t i, bool_t is_key )
{
    bool_t ret= TRUE;

    STACK_GROW( L2, 1 );

  //STACK_CHECK(L)

    switch ( lua_type(L,i) ) {
        /* Basic types allowed both as values, and as table keys */

        case LUA_TBOOLEAN:
            lua_pushboolean( L2, lua_toboolean(L, i) );
            break;

        case LUA_TNUMBER:
            /* LNUM patch support (keeping integer accuracy) */
#ifdef LUA_LNUM
            if (lua_isinteger(L,i)) {
                lua_pushinteger( L2, lua_tointeger(L, i) );
                break;
            }
#endif
            lua_pushnumber( L2, lua_tonumber(L, i) ); 
            break;

        case LUA_TSTRING: {
            size_t len; const char *s = lua_tolstring( L, i, &len );
            lua_pushlstring( L2, s, len );
            } break;

        case LUA_TLIGHTUSERDATA:
            lua_pushlightuserdata( L2, lua_touserdata(L, i) );
            break;

        /* The following types are not allowed as table keys */

        case LUA_TUSERDATA: if (is_key) { ret=FALSE; break; }
            /* Allow only "shared userdata" entities to be copied across
             * separate Lua states.
             */
            if (!luaG_copyshared( L, L2, i )) {
                // Cannot copy it full; copy as light userdata
                //
                lua_pushlightuserdata( L2, lua_touserdata(L, i) );
            } break;

        case LUA_TNIL: if (is_key) { ret=FALSE; break; }
            lua_pushnil(L2);
            break;

        case LUA_TFUNCTION: if (is_key) { ret=FALSE; break; } {
            lua_CFunction cfunc= lua_tocfunction( L,i );
            unsigned n;
            int L2_oldtop= lua_gettop(L2);

          STACK_GROW(L,2);

          STACK_CHECK(L)
            if (!cfunc) {   // Lua function
                luaL_Buffer b;
                const char *s;
                size_t sz;
                int tmp;
                const char *name= NULL;

#if 0
                // "To get information about a function you push it onto the 
                // stack and start the what string with the character '>'."
                //
                { lua_Debug ar;
                lua_pushvalue( L, i );
                lua_getinfo(L, ">n", &ar);      // fills 'name' and 'namewhat', pops function
                name= ar.namewhat;
                
                fprintf( stderr, "NAME: %s\n", name );  // just gives NULL
                }
#endif 
                // 'lua_dump()' needs the function at top of stack
                //
                if (i!=-1) lua_pushvalue( L, i );

                luaL_buffinit(L,&b);
                tmp= lua_dump(L, buf_writer, &b);
                ASSERT_L(tmp==0);
                    //
                    // "value returned is the error code returned by the last call 
                    // to the writer" (and we only return 0)

                luaL_pushresult(&b);    // pushes dumped string on 'L'
                s= lua_tolstring(L,-1,&sz);
                ASSERT_L( s && sz );

                if (i!=-1) lua_remove( L, -2 );

                // Note: Line numbers seem to be taken precisely from the 
                //       original function. 'name' is not used since the chunk
                //       is precompiled (it seems...). 
                //
                // TBD: Can we get the function's original name through, as well?
                //
                if (luaL_loadbuffer(L2, s, sz, name) != 0) {
                    // chunk is precompiled so only LUA_ERRMEM can happen
                    // "Otherwise, it pushes an error message"
                    //
                    STACK_GROW( L,1 );
                    luaL_error( L, "%s", lua_tostring(L2,-1) );
                }
                lua_pop(L,1);   // remove the dumped string
          STACK_MID(0)
            }

            /* push over any upvalues
            */
            for( n=0; lua_getupvalue( L, i, 1+n ) != NULL; n++ ) {
                if (!inter_copy_one( L, L2, lua_gettop(L), FALSE /*no key*/ ))
                    luaL_error( L, "Cannot copy upvalue type '%s'", luaG_typename(L,-1) );

                lua_pop(L,1);
            }
            // L2: 'n' upvalues (>=0) pushed

          STACK_MID(0)

            if (cfunc) {
                lua_pushcclosure( L2, cfunc, n );   // eats up upvalues
            } else {
                // Set upvalues (originally set to 'nil' by 'lua_load')
                //
                int func_index= lua_gettop(L2)-n;

                for( ; n>0; n-- ) {
                    const char *rc= lua_setupvalue( L2, func_index, n );
                        //
                        // "assigns the value at the top of the stack to the upvalue and returns its name.
                        // It also pops the value from the stack."
                    
                    ASSERT_L(rc);      // not having enough slots?
                }
            }
          STACK_END(0)
          ASSERT_L( lua_gettop(L2) == L2_oldtop+1 );
            } break;

        case LUA_TTABLE: if (is_key) { ret=FALSE; break; } {
            lua_newtable( L2 );
            STACK_GROW( L, 2 );
            STACK_GROW( L2, 2 );

          STACK_CHECK(L)
            lua_pushnil(L);    // start iteration
            while( lua_next( L, i ) ) {
                uint_t val_i= lua_gettop(L);
                uint_t key_i= val_i-1;

                /* If the value is our table itself; avoid eternal loop.
                 * This prevents the '_G._G...' case, but is not intended to
                 * detect cyclic tables.
                 */
                if (!lua_equal( L, val_i, i )) {
    
                    /* Only basic key types are copied over; others ignored
                     */
                    if (inter_copy_one( L, L2, key_i, TRUE /*key*/ )) {
                        if (inter_copy_one( L, L2, val_i, FALSE /*value*/ )) {
                            ASSERT_L( lua_istable(L2,-3) );
                            lua_rawset( L2, -3 );    // add to table (pops key & val)
                        } else {
                            luaL_error( L, "Unable to copy over type '%s' (in table)", luaG_typename(L,val_i) );
                        }
                    }
                }
                lua_pop( L, 1 );    // pop value (next round)
            }
          STACK_END(0)
            } break;

        /* The following types cannot be copied */

        case LUA_TTHREAD: 
            ret=FALSE; break;
    }

  //STACK_END(0)

    return ret;
}


/*
* Akin to 'lua_xmove' but copies values between _any_ Lua states.
*
* NOTE: Both the states must be solely in the current OS thread's posession.
*
* Note: Parameters are in this order ('L' = from first) to be same as 'lua_xmove'.
*/
void luaG_inter_copy( lua_State* L, lua_State *L2, uint_t n )
{
    uint_t top_L= lua_gettop(L);
    uint_t top_L2= lua_gettop(L2);
    uint_t i;

    if (n > top_L) 
        luaL_error( L, "Not enough values: %d < %d", top_L, n );

    STACK_GROW( L2, n );

    for (i=top_L-n+1; i <= top_L; i++) {
        if (!inter_copy_one( L, L2, i, FALSE /*not table key*/ )) {
       
            luaL_error( L, "Cannot copy type: %s", luaG_typename(L,i) );
       }
    }
  
    ASSERT_L( lua_gettop(L) == top_L );
    ASSERT_L( lua_gettop(L2) == top_L2+n );
}


void luaG_inter_move( lua_State* L, lua_State *L2, uint_t n )
{
    luaG_inter_copy( L, L2, n );
    lua_pop( L,n );
}
